home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #41 (Feb 89) / basic code / Color Picker.BAS < prev   
BASIC Source File  |  1988-12-12  |  4KB  |  161 lines
  1. 'Color Picking with ZBasic 5.0
  2. '©MacTutor 1989
  3. 'By Dave Kelly
  4.  
  5. WINDOW OFF
  6. COORDINATE WINDOW
  7. DIM Colorbox%(3),inColor%(3),outColor%(3),Point%(2),AlertText$(4)
  8. DIM RGB1%(3),PaletteRect%(3)
  9. red&=65535
  10. green&=0
  11. blue&=0
  12.  
  13. DEF MOUSE=-1
  14. false%=0:true%=NOT(false)
  15.  
  16. GOSUB "GetColorMode"
  17.     IF ColorMode%>256 THEN ColorMode%=256 
  18.     LONG IF ColorMode%<16
  19.         AlertText$(1)=""
  20.         AlertText$(2)="This Demo must be run on a"
  21.         AlertText$(3)=" Mac ][ in 16 or 256 colors"
  22.         AlertText$(4)=""
  23.         CALL PARAMTEXT(AlertText$(1),AlertText$(2),AlertText$(3),AlertText$(4))
  24.         AlertAns%=FN NOTEALERT(1,0)
  25.         GOTO "Quit"
  26.     END IF
  27.  
  28. MENU 1,0,1,"File"
  29. MENU 1,1,1,"Select Color"
  30. MENU 1,2,1,"Quit"
  31. EDIT MENU 2
  32.  
  33. 'Find out screen size.
  34. CALL GETWMGRPORT(WMgrPort&)
  35. PortTop=PEEK WORD(WMgrPort&+8)
  36. PortLeft=PEEK WORD(WMgrPort&+10)
  37. PortBottom=PEEK WORD(WMgrPort&+12)
  38. PortRight=PEEK WORD(WMgrPort&+14)
  39.  
  40. WINDOW 1,"Main Window",(10,44)-(PortRight-4,PortBottom-4),5
  41. GET WINDOW #1, WindowPtr&
  42. TEXT ,,,0
  43. BUTTON #6,1,"Quit",(20,WINDOW(3)-50)-(85,WINDOW(3)-30),1
  44. BUTTON #7,1,"Pick Color",(120,WINDOW(3)-50)-(195,WINDOW(3)-30),1
  45. CALL SETRECT(Colorbox%(0),10,10,WINDOW(2)-10,WINDOW(3)-215)
  46. PICTURE ON
  47. LONG COLOR blue&,green&,red&
  48. CALL PAINTRECT(Colorbox%(0))
  49. COLOR=7
  50. CALL FRAMERECT(Colorbox%(0))
  51. CALL MOVETO(20,WINDOW(3)-100)
  52. PRINT "Red:";red&;" Green:";green&;" Blue:";blue&;SPACE$(10)
  53. PICTURE OFF,Pic1&
  54. PICTURE, Pic1&
  55. WINDOW PICTURE #1,Pic1&
  56.  
  57. ON DIALOG GOSUB "Event"
  58. ON MENU GOSUB "MenuEvent"
  59. DIALOG ON:MENU ON
  60. "Loop"
  61. GOTO "Loop"
  62. DIALOG STOP:MENU STOP
  63.  
  64. "MenuEvent"
  65. Menunumber=MENU(0)
  66. Menuitem=MENU(1)
  67. MENU
  68. IF Menunumber<>1 THEN RETURN
  69. SELECT Menuitem
  70.     CASE 1
  71.         GOSUB "ColorPick"
  72.  CASE 2
  73.         GOSUB "Quit"
  74. END SELECT
  75. RETURN
  76.  
  77. "Quit"
  78. WINDOW PICTURE #1,0
  79. KILL PICTURE Pic1&
  80. END
  81.  
  82. "ColorPick":'A Color Selection routine
  83. inColor%(0)=red&
  84. inColor%(1)=green&
  85. inColor%(2)=blue&
  86. Result=FN GETCOLOR(Point%(0),"Choose the best color!",inColor%(0),outColor%(0))
  87. LONG IF Result<>0
  88.     red&=outColor%(0)
  89.     green&=outColor%(1)
  90.     blue&=outColor%(2)
  91.     IF red&<0 THEN red&=65536+red&
  92.     IF green&<0 THEN green&=65536+green&
  93.     IF blue&<0 THEN blue&=65536+blue&
  94.     PICTURE ON
  95.     LONG COLOR blue&,green&,red&
  96.     CALL SETRECT(Colorbox%(0),10,10,WINDOW(2)-10,WINDOW(3)-215)
  97.     CALL PAINTRECT(Colorbox%(0))
  98.     COLOR=7
  99.     CALL FRAMERECT(Colorbox%(0))
  100.     CALL MOVETO(20,WINDOW(3)-100)
  101.     PRINT "Red:";red&;" Green:";green&;" Blue:";blue&;SPACE$(10)
  102.     PICTURE OFF,Pic1&
  103.     PICTURE, Pic1&
  104.     WINDOW PICTURE #1,Pic1&
  105. END IF
  106. RETURN
  107.  
  108. "Event"
  109.     D=DIALOG(0)
  110. SELECT D
  111.     CASE 1
  112.         GOSUB "ButtonEvent"
  113.     CASE 4
  114.         GOSUB "Quit":'if close box selected
  115. END SELECT
  116. RETURN
  117.  
  118. "ButtonEvent"
  119. Buttonpressed=DIALOG(1)
  120. IF Buttonpressed=6 THEN "Quit"
  121. IF Buttonpressed=7 THEN "ColorPick"
  122. RETURN
  123.  
  124. REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  125. REM
  126. "GetColorMode" 'With thanks to Zedcor and Bob Andrus
  127. REM
  128. REM  SUBROUTINE TO GET THE B&W/COLOR MODE
  129. REM
  130. REM  ROM85=&H028E
  131. REM
  132. REM  RomTypeW& = -1    FOR 128K OR 512K
  133. REM  RomTypeW& = 32767 FOR PLUS OR SE
  134. REM  RomTypeW& = 16383 FOR ][
  135. REM
  136.     ROM85&=&H028E
  137.     RomTypeW&=PEEK WORD(ROM85&)
  138. REM
  139. REM  TheGDevice=&H0CC8
  140. REM
  141. REM  gdMode& = 128 FOR   2 B&W OR COLORS
  142. REM  gdMode& = 129 FOR   4 B&W OR COLORS
  143. REM  gdMode& = 130 FOR  16 B&W OR COLORS
  144. REM  gdMode& = 131 FOR 256 B&W OR COLORS
  145. REM
  146.     TheGDevice&=&H0CC8
  147.     GDHandle&=PEEK LONG(TheGDevice&)
  148.     GDPtr&=PEEK LONG(GDHandle&)
  149.     gdMode&=PEEK LONG(GDPtr&+42)
  150. REM
  151. REM  GET THE B&W/COLOR MODE
  152. REM
  153.     IF RomTypeW&<>16383 THEN ColorMode%=2
  154.     IF RomTypeW&<>16383 THEN RETURN
  155.     IF gdMode&=128 THEN ColorMode%=2
  156.     IF gdMode&=129 THEN ColorMode%=4
  157.     IF gdMode&=130 THEN ColorMode%=16
  158.     IF gdMode&=131 THEN ColorMode%=256
  159.     RETURN
  160.  
  161.